Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/TIPS/SPLASH.PAS

Pascal/Delphi Source File | 1991-10-09 | 2KB | 65 lines

{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Tips & Techniques Demo Program               }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

program Splash;

{$R Splash}

uses WinProcs, WinTypes, WObjects;

type
  TApp = object(TApplication)
    constructor Init(AName: PChar);
    procedure InitMainWindow; virtual;
  end;

var
  SplashRect: TRect;

{ Before calling the parent constructor, create a 'Display'
  DC and BitBlt the desired region }
constructor TApp.Init(AName: PChar);
var
  DC, MemDC: HDC;
  OldBitMap, BitMap: HBitMap;
  BM: TBitMap;
begin
  DC := CreateDC('Display', Nil, Nil, Nil);
  BitMap := LoadBitMap(HInstance, 'Splash');
  MemDC := CreateCompatibleDC(DC);
  OldBitMap := SelectObject(MemDC, BitMap);
  GetObject(BitMap, SizeOf(BM), @BM);
  with SplashRect do
  begin
    Left := 200;
    Top := 150;
    Right := Left + BM.bmWidth;
    Bottom := Top + BM.bmHeight;
    BitBlt(DC, Left, Top, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCopy);
  end;
  DeleteObject(SelectObject(MemDC, OldBitMap));
  DeleteDC(MemDC);
  DeleteDC(DC);
  TApplication.Init(AName);
end;

procedure TApp.InitMainWindow;
begin
  MainWindow := New(PWindow, Init(Nil, 'Splash Test'));
end;

var
  App: TApp;
begin
  App.Init('Splash');
  { invalidate the Splashed region to cause a paint }
  InvalidateRect(0, @SplashRect, True);
  App.Run;
  App.Done;
end.